home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
mapl0301.zip
/
MBS20301.MRG
< prev
next >
Wrap
Text File
|
1993-03-01
|
95KB
|
2,415 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against E:\RBBS\STOCK\RBBSSUB2.BAS to produce E:\RBBS\CHAT\RBBSSUB2.BAS
* E:\RBBS\STOCK\RBBSSUB2.BAS: Date 6-20-1992 Size 140946 bytes
* ------------[ Created 03-01-1993 19:14:30 ]------------
* REPLACING old line(s) by new
' $linesize:132
' $title: 'RBBSSUB2.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
' Copyright 1991 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB2.BAS
' First Released .....: June 21, 1992
' Subsequent Releases.:
' Copyright ..........: 1986 - 1992
' Purpose.............: The Remote Bulletin Board System for the IBM PC,
' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not
' require error trapping are incorporated within RBBSSUB 2-5 as
' separately callable subroutines in order to free up as much
' code as possible within the 64K code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' Macro 1320 Check/execute macro
' AnswerIt 200 Answer the telephone when it rings
' ASCIICodes 129 Allow a CONFIG string to have any ASCII value
' BadChar 455 Check user name for invalid characters
' BadName 20235 Check for system crash attempt with bad file name
' BankTime 5500 Let caller change banked time
' CheckRatio 20096 Test upload/download ratio
' CheckMacro 1242 Checks for macro and processes
' CopyRight 97 Display RBBS-PC's copyright notice
' DEFALTU 9600 Write out the user's defaults
' DenyAccess 1386 Downgrade security so access denied
' DoorExit 10983 Set up a .BAT file to exit RBBS-PC to a "door"
* ------[ first line different ]------
' DosExit 10934 Set up a .BAT file to exit to DOS (second level)
' EditALine 2618 Edits a single line
' EditDef 120 Edit configuration parameters
' FileNameCheck 20240 Matches file name to a prefix & extension
' GetArc 20140 Handle request for verbose listing
' GetCommand 101 Get RBBS-PC's node id from command line
' GetTime 9140 Calculates callers elapsed time (hh,mm,ss)
' GoIdle 90 Release resources when waiting for keyboard input
' KillMsg 3952 Delete old or unnecessary messages
' Line25 945 Build and/or update line 25 of RBBS-PC's local screen
' LineEdit 3700 Edit a line while minimizing string space consumption
' LogError 13660 Log error message to CALLERS file
' LPrnt 1480 Subroutine to write to local display
' MLInit 8 Removed in Maple code
' MsgProt 2055 Sets protection for a message
' ParseIt 1637 Parses a string
' PassWrd 660 Verify user & message passwords
' PopCmdStack 1650 Get user input, 1st checking command stack
' PScrn 1483 Print to display
' QuickLPrnt 1482 Quickly writes count of blocks on file transfer
' QuickTPut 1478 Fast, but limited, "TPut" equivalent
' QuickTPut1 1478 Outputs short string following by CR LF
' RBBSExit 10992 RBBS-PC exit to transfer control to other programs
' RecoverMsg 10410 Recover a deleted message
' RemNonAlf 5100 Removes non-alpha characters from a string
' RingCaller 1636 Ring caller's bell and put message in emphasis
' SetBaud 1654 Set baud rate in the 8250 chip of the RS232 interface
' SetCrLf 1496 Set up the necessary carriage return/line feed string
' SetSection 12000 Set the proper section prompts (main, file, util, libr)
' SetThread 4554 Set up request for threading thru messages
' SetWhoTo 2018 Sets who a message/personal upload is to
' SkipLine 1485 Write a # of blank lines to the communications port
' SearchCmd 1238 Searches list of commands in RBBS for a request
' SecViolation 1380 Process a security violation
' SysMenu 112 Displays sysop menu/status 'Moved to MenuPlus.bas Pe021493
' SysopChat 4773 Sysop and caller chat
' TestRel 336 Tests for Reliable connect
' TGet 1498 Read a line from the communications port
' TPut 1396 Write a line to the communications port
' Trim 105 Strip leading and trailing blanks from a string
' TrimTrail 107 Strip off specified string off end of another string
' UntilRight 12878 Ask a question until user says answer is right
' UpdateU 10600 Updates the user record on loging off/exiting RBBS-PC
' VarInit 109 Initialize system variables
' ViewHelp 1330 Processes help command
' WhoCheck 2250 Checks whether a user exists in user file
' WhosOn 9801 Report status of each node - who's on
' WordInFile 10976 Find a whole word within a file/menu
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
* DELETING old line(s)
10
20
30
60
70
80
* REPLACING old line(s) by new
90 ' $SUBTITLE: 'GoIdle - release control when waiting'
' $PAGE
'
' NAME -- GoIdle
'
' INPUTS -- ZMLCom
' ZNetworkType
'
' OUTPUTS -- NONE
'
' PURPOSE -- To relinquish control when RBBS-PC is waiting for
' input from the communications port
'
SUB GoIdle STATIC
* ------[ first line different ]------
CALL GiveBack
END SUB
* REPLACING old line(s) by new
97 ' $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
' $PAGE
'
' NAME -- CopyRight
'
' INPUTS -- NONE
'
' OUTPUTS -- NONE
'
' PURPOSE -- To display RBBS-PC's copyright notice on the local screen
'
SUB CopyRight STATIC
ZWasA = (ZDebug OR ZExitToDoors OR ZCopyrightSecs < 1)
IF ZWasA THEN _
EXIT SUB
WIDTH 80
* ------[ first line different ]------
CLS
KEY OFF
LOCATE ,,0
ZWasA = ZSnoop
ZSnoop = -1
CALL BufFile("COPYRITE.DEF",WasX)
If Not ZOK Then
Call GetRBBSString(267,RBBSString$) 'Pe 01/16/93
Call QuickTput1(RBBSString$)
Call Delaytime (35)
End IF
CALL DelayTime (ZCopyrightSecs)
ZSnoop = ZWasA
END SUB
* REPLACING old line(s) by new
101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
' $PAGE
'
' NAME -- GetCommand
* ------[ first line different ]------
' INPUTS -- PARAMETER MEANING
' ZConfigFileName$ NAME OF RBBS-PC ".DEF" FILE TO
' USE AS A MODEL WHEN CREATING THE
' .DEF FILE NAME TO BE USED BY THIS
' COPY OF RBBS-PC.
'
' COMMAND LINE COMMAND LINE USED TO INVOKE
' RBBS-PC IN THE FORM:
'
' RBBS-PC.EXE x filename DEBUG /time /baud /CBaud /reliable
'
' WHERE THE OPTIONAL PARAMETERS ARE:
'
' x IS THE NODE ID IN THE RANGE 1-9,0,A-Z
' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
' DEBUG IS A DEBUGGING Switch
' /time IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
' /baud IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
' ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
' USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
' PROGRAM
' /Cbaud IS Actuall Connect rate of the Modems ' Pe 01/01/93
' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
'
' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
'
' OUTPUTS -- ZConfigFileName$ NAME OF RBBS-PC ".DEF" FILE FOR
' THIS COPY OF RBBS-PC TO USE
' ZNodeRecIndex RECORD NUMBER WITHIN THE
' MESSAGES FILE FOR THIS "NODE"
' (RANGE IS 2 TO 36)
'
' PURPOSE -- To get node id from command line and determine if rbbs
' is being run as a door
'
SUB GetCommand (PassedDebug,NetTime$,NetBaud$,ZCBaud$,NetReliable$) STATIC ' Pe 01/01/93
STATIC ZDebug
'
'
' * GET NODE ID FROM COMMAND LINE
'
'
WasPM$ = COMMAND$
CALL AllCaps(WasPM$)
IF INSTR(WasPM$,"/") = 0 THEN _
GOTO 103
'
'
' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
'
'
CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
ZWasA = 0
FOR WasX = 1 TO LEN(CmdLine$)
IF MID$(CmdLine$,WasX,1) = "/" THEN _
ZWasA = ZWasA + 1 : _
ZSubDir$(ZWasA) = "" _
ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
NEXT
NetTime$ = ZSubDir$(1)
IF ZWasA > 1 THEN _
NetBaud$ = ZSubDir$(2)
IF ZWasA > 2 THEN _
ZCBaud$ = STR$(VAL(ZSubDir$(3))) 'Pe 031692
IF ZWasA > 3 THEN _
NetReliable$ = ZSubDir$(4) 'lk 022792
CALL Trim(NetTime$)
CALL Trim(NetBaud$)
CALL Trim (ZCBaud$)
CALL Trim(NetReliable$)
* REPLACING old line(s) by new
109 ' $SUBTITLE: 'VarInit - subroutine to initialize system variables'
' $PAGE
'
' NAME -- VarInit
'
' INPUTS -- PARAMETER MEANING
' NONE
'
' OUTPUTS -- NONE
'
' PURPOSE -- To initialize system variable
'
SUB VarInit STATIC
DEF SEG ' Point to BASIC
WIDTH 80 ' Set Screen Width
KEY OFF ' Line 25 turned off
' ********************* Variable Definitions *******************************
* ------[ first line different ]------
' ZMsgDim = 99
ZMsgDim = 199 'pe021893
WasMM = 999
WasBX = 75
WasJ = 60
REDIM ZOptSec(WasJ)
DIM ZWorkAra$(WasJ)
DIM ZGSRAra$(WasJ)
DIM ZCategoryName$(WasBX),ZCategoryCode$(WasBX),ZCategoryDesc$(WasBX)
DIM ZOutTxt$(ZMsgDim) ' Message line table
DIM ZUserIn$(ZMsgDim) ' Message line table
DIM ZMsgPtr(WasMM,2) ' Message pointers
ZAcknowledge$ = CHR$(6)
ZAckChar$ = "C" + _
ZAcknowledge$
' ZActiveMenu$ = "B"
ZActiveMenu$ = "|" 'ANSIed243
ZActiveMessage$ = CHR$(225)
ZBackSpace$ = CHR$(8) + _
CHR$(32) + _
CHR$(8)
ZBackArrow$ = CHR$(29) + _
CHR$(32) + _
CHR$(29)
ZBaudRates$ = " 300 450 1200 2400 4800 7200 96001200014400168001920038400"
ZBellRinger$ = CHR$(7)
ZBulletinMenu$ = ""
ZWasCL = 24
ZCancel$ = CHR$(24)
ZColorReset$ = CHR$(27) + _
"[00;37;40m"
ZConfigFileName$ = "RBBS-PC.DEF"
ZCarriageReturn$ = CHR$(13)
ZDeletedMsg$ = CHR$(226)
ZEndTransmission$ = CHR$(4)
ZEscape$ = CHR$(27)
ZExpectActiveModem = 0
ZFalse = 0
ZF1Key = 59
ZF10Key = 68
ZConfName$ = "MAIN"
CALL SetHiLite (ZTrue)
ZHomeConf$ = ""
ZInConfMenu = -1
ZLastCommand$ = "M "
ZLimitMinsPerSession = 0
ZLineFeed$ = CHR$(10)
ZLineFeeds = NOT ZFalse
ZLineEditChk$ = CHR$(9) + _
ZLineFeed$ + _
CHR$(11) + _
CHR$(12) + _
CHR$(127) + _
CHR$(8) + _
ZBellRinger$ + _
CHR$(26) + _
CHR$(227)
ZLineMes$ = SPACE$(78) ' fixed length string workspace
ZLockStatus$ = "UM UU UB UD"
ZMenuIndex = 2
ZNAK$ = CHR$(21)
ZNoAdvance = ZFalse
ZPageLength = 23
ZParseOff = ZFalse
ZPressEnter$ = " (Press [ENTER] to quit)"
ZPressEnterExpert$ = " ([ENTER] quits)"
ZPressEnterNovice$ = ZPressEnter$
ZPrivateDoor = ZFalse
ZRightMargin = 72
ZReturnLineFeed$ = ZCarriageReturn$ + _
ZLineFeed$
ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
"C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
"TY TN BN ND FS LS CN "+ _
"C5 C6 C7 C8 C9 CA CB CC CD CE CF" ' DD061303
ZStartOfHeader$ = CHR$(1)
ZTimeLoggedOn$ = SPACE$(8)
ZTrue = NOT ZFalse
ZUpInc = -1
ZXOff$ = CHR$(19)
ZXOn$ = CHR$(17)
ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
ZOptionEnd$ = ZReturnLineFeed$ + " ,("
ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
ZVersionID$ = " Mpl030193"
ZWasLG$(1) = "Registration Check Failed"
ZWasLG$(2) = "Sysop name attempted"
ZWasLG$(3) = "Locked out attempt"
ZWasLG$(4) = "Password Attempt Failed"
ZWasLG$(5) = "Auto Lockout done"
ZWasLG$(6) = "Name in use on another Node!"
ZWasLG$(7) = ""
ZWasLG$(8) = "Locked reason read!"
ZWasLG$(9) = "Expired Registration"
CALL GetCommand (ZDebug,ZNetTime$,ZNetBaud$,ZCBaud$,ZNetReliable$) 'Pe 01/01/93
ZSubParm = 1
CALL ReadDef (ZConfigFileName$)
REDIM ZWorkAra$(ZMaxWorkVar)
REDIM ZGSRAra$(ZMaxWorkVar)
ZUseTPut = (ZUpperCase OR ZXOnXOff)
ZOrigCallers$ = ZCallersFile$
ZOrigMsgFile$ = ZMainMsgFile$
ZOrigUserFile$ = ZMainUserFile$
ZOrigSysopFN$ = ZSysopFirstName$
ZOrigSysopLN$ = ZSysopLastName$
ZPromptBell = ZPromptBellDef
ZSecretName$ = ZSysopPswd1$ + " " + ZSysopPswd2$
IF NOT ZSubBoard THEN _ 'lk 022092 for toss mod
ZOrigRBBSName$ = ZRBBSName$ 'lk 022092 for toss mod
END SUB
'
* DELETING old line(s)
112
* REPLACING old line(s) by new
120 ' $SUBTITLE: 'EditDef - sub to edit config parameters'
' $PAGE
'
' NAME -- EditDef
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- OUTPUT STRING
'
' PURPOSE -- Interpretes and adjusts stored configuration parameters
'
SUB EditDef STATIC
* ------[ first line different ]------
ZMinsPerSessionDef = ZMinsPerSession ' KG082101
ZAllOpts$ = ZMainCmds$ + _
ZFileCmd$ + _
ZUtilCmds$ + _
ZLibCmds$ + _
ZGlobalCmnds$ + _
ZSysopCmds$
ZHelpExtension$ = "." + _
ZHelpExtension$
ZCompressedExt$ = ZDefaultExtension$
ZWasQ = INSTR(ZDefaultExtension$,".")
IF ZWasQ > 0 THEN _
ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
ZCurDirPath$ = ZDirPath$
ZTempExpiredSec = ZExpiredSec
ZBegMain = 1
ZBegFile = LEN(ZMainCmds$) + ZBegMain
ZBegUtil = LEN(ZFileCmd$) + ZBegFile
ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
ZHelp$(3) = ZHelpPath$ + _
ZHelp$(3)
ZHelp$(4) = ZHelpPath$ + _
ZHelp$(4)
ZHelp$(7) = ZHelpPath$ + _
ZHelp$(7)
ZHelp$(9) = ZHelpPath$ + _
ZHelp$(9)
CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
Extension$,ZTrue)
CALL ASCIICodes ("[","]",ZDefaultLineACK$)
CALL ASCIICodes ("[","]",ZHostEchoOn$)
CALL ASCIICodes ("[","]",ZHostEchoOff$)
CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
ZDR1$ = ZFG1Def$
ZDR2$ = ZFG2Def$
ZDR3$ = ZFG3Def$
ZDR4$ = ZFG4Def$
IF ZSubParm = -62 THEN _
EXIT SUB
ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
IF ZLocalUserMode THEN _
ZRecycleToDos = ZTrue
ZEchoer$ = ZDefaultEchoer$
IF LEN(ZScreenOutMsg$) < 2 THEN _
ZScreenOutMsg$ = ZStartOfHeader$
ZSmartTextCode$ = CHR$(ZSmartTextCode)
IF ZMaxWorkVar < 13 THEN _
ZMaxWorkVar = 13
'
' *** ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE ***
'
IF ZMainFMSDir$ <> "" THEN _
ZFMSDirectory$ = ZDirPath$ + _
ZMainFMSDir$ + _
"." + _
ZMainDirExtension$ : _
ZActiveFMSDir$ = ZFMSDirectory$ : _
ZUpcatHelp$ = ZHelpPath$ + _
ZUpcatHelp$ + _
ZHelpExtension$
IF ZSubDirCount < 1 THEN _
GOTO 123
FOR ZSubDirIndex = 1 TO ZSubDirCount
INPUT #2,ZSubDir$
IF RIGHT$(ZSubDir$,1) <> "\" THEN _
ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
"\" _
ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
NEXT
GOTO 125
* REPLACING old line(s) by new
126 CLOSE #2
* ------[ first line different ]------
' ZSubParm = -10
' CALL Carrier
'
' *** INITIALIZE OMNINET INTERFACE IF OMNINET IN USE ***
'
* REPLACING old line(s) by new
128 IF ZNetworkType = 2 THEN _
ZWasCN$ = SPACE$(535) : _
CALL InitIO(ZWasA)
* ------[ first line different ]------
'YW = 268
'For X = 1 to 9
' Call GetRBBSString(YW,RBBSString$) 'Pe 01/16/93
' ZWasLG$(X) = RBBSString$ 'Pe 01/16/93
' YW = YW + 1
'Next X
END SUB
'
* REPLACING old line(s) by new
235 ZEightBit = ZTrue
IF ZExitToDoors THEN _
* ------[ first line different ]------
CALL ReadProf(1) 'Pe 12/20/92
ZSubParm = -10
CALL Carrier
IF ZSubParm = 0 AND _
ZExitToDoors THEN _
ZSubParm = 1 : _
GOTO 335
IF ZSubParm = 0 AND _
ZExpectActiveModem THEN _
ZBaudTest! = VAL(ZNetBaud$) : _
CALL TestRel (ZNetReliable$) : _
GOTO 328
IF ZExpectActiveModem OR _
ZExitToDoors THEN _
ZSubParm = 4 : _
ZExitToDoors = ZFalse : _
EXIT SUB
IF ZSubParm = 0 THEN _
ConnectDelay! = TIMER + ZMaxCarrierWait : _
GOTO 324
CALL SysMenu
CALL ModemPut (ZModemResetCmd$)
CALL DelayTime (ZModemInitWaitTime)
CALL ModemPut (ZModemInitCmd$)
RingBack = ZFalse
Call LocateMenu (RingBack,ScreenCleared,AOK,1) ' Pe menu174
If AOK = ZTrue THEN _ ' Pe Menu174
If RingBack Then _
Goto 236 _
Else GOTO 237 ' Pe menu174
LOCATE 16,55
IF ZRequiredRings = 0 THEN _
CALL LPrnt("WAITING FOR CARRIER",0) : _
GOTO 237
IF MID$(ZModemInitCmd$, _
INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
CALL LPrnt("RING BACK SYSTEM",0) : _
RingBack = ZTrue : _
GOTO 236
CALL LPrnt(" WAITING FOR RING ",0)
* REPLACING old line(s) by new
* ------[ first line different ]------
236 Call LocateMenu (RingBack,ScreenCleared,AOK,2) ' Pe Menu174
IF AOK = ZTrue THEN _ ' Pe Menu174
GOTO 237 ' Pe Menu174
LOCATE 16,76 : _
CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
* REPLACING old line(s) by new
* ------[ first line different ]------
237 Call LocateMenu (RingBack,ScreenCleared,AOK,3)
IF AOK <> ZTrue THEN
LOCATE 18,76
IF ZDosANSI THEN _
CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
ELSE CALL LPrnt ("YES",0)
COLOR ZFG,ZBG,ZBorder
LOCATE 20,56
END IF
'
'
' * GET READY TO ANSWER INCOMMING CALL:
' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
' * REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
' * First CALLS AND THEN HANGS UP (I.E. RING-BACK).
' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
'
'
WasQQ = 255
WasI = INSTR(ZModemInitCmd$,"S0")
IF WasI = 0 THEN _
GOTO 239
IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
WasQQ = 0 : _
ZBlk = WasQQ
ZSecsUsedSession! = TIMER
ZSubParm = 1
CALL Line25
RingAnswer = ZTrue
IF RingBack THEN _
RingAnswer = ZFalse
* REPLACING old line(s) by new
260 IF RingBackWaitStart! > 0 THEN _
CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
IF TempElapsed! > 45 THEN _
RingBackWaitStart! = 0 : _
RingBackCount = 0 : _
RingAnswer = ZFalse: _
IF RingBack THEN _
* ------[ first line different ]------
Call LocateMenu (RingBack,ScreenCleared,AOK,4) : _ ' Pe menu174
If AOK = ZTrue Then Goto 265 _ ' Pe Menu174
Else LOCATE 20,56 : _
CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
'
' Comments out the Following lines if you DO NOT want the screen to
' Blank Automaticaly... 120 Sec = 2 min adjust if desired
'
' DO NOT comment out the LINE NUMBER, just the CODE !!
* REPLACING old line(s) by new
* ------[ first line different ]------
265 ' Call LocateMenu (RingBack,ScreenCleared,AOK,5) ' Pe 02/08/93
CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2) 'RT020193MPL
IF TempElapsed! > 120 AND NOT ScreenCleared THEN _ 'RT020193MPL
LOCATE ,,0 : _ 'RT020193MPL
CLS : _ 'RT020193MPL
ZWasCL = 1 : _ 'RT020193MPL
ScreenCleared = ZTrue : _ 'RT020193MPL
ZSecsUsedSession! = TIMER 'RT020193MPL
IF ZTimeToDropToDos! > 0 THEN _
IF ZOldDate$ <> DATE$ THEN _
IF TIMER => ZTimeToDropToDos! AND _
TIMER < 86340 THEN _ ' Skip btw 23:59 and 00:00
ZSubParm = 7 : _
EXIT SUB
Call LocateMenu (RingBack,ScreenCleared,AOK,5) ' Pe021293
* REPLACING old line(s) by new
* ------[ first line different ]------
305 Call LocateMenu (RingBack,ScreenCleared,RingBack,AOK,6)
If AOK = ZTrue Then Goto 310
LOCATE 20,56
CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
* REPLACING old line(s) by new
325 CALL FlushCom(WasX$)
IF ZSubParm = -1 THEN _
IF ZErrCode = 69 THEN _
ZSubParm = 5 : _
EXIT SUB
ModemResponse$ = ModemResponse$ + WasX$
IF LEN(ModemResponse$) > 200 THEN _
ModemResponse$ = RIGHT$(ModemResponse$,20)
CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
IF TempElapsed! <= 0 THEN _
CALL UpdtCalr ("Connect timeout",1) : _
ZSubParm = 4 : _
EXIT SUB
IF ZDumbModem THEN _
ZBaudTest! = VAL(ZModemInitBaud$) : _
GOTO 327
IF INSTR(ModemResponse$,"FAST") THEN _
ZBaudTest! = 19200 : _
GOTO 327
IF INSTR(ModemResponse$,"ONNECT") THEN _
* ------[ first line different ]------
CALL DelayTime(2) : _ 'RT022293
CALL FlushCom(WasX$) : _ 'RT022293
ModemResponse$ = ModemResponse$ + Wasx$ : _ 'RT022293
ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
GOTO 327
IF INSTR(ModemResponse$,"ONLINE") THEN _
CALL DelayTime(2) : _ 'RT022293
CALL FlushCom(WasX$) : _ 'RT022293
ModemResponse$ = ModemResponse$ + Wasx$ : _ 'RT022293
ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
GOTO 327
GOTO 324
* REPLACING old line(s) by new
328 CALL SetBPS (ZBaudTest!,ZBPS)
* ------[ first line different ]------
IF ZBPS = 0 THEN GOTO 324 'Lk 02/28/92
* REPLACING old line(s) by new
336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
' $PAGE
'
' NAME -- TestRel
'
' INPUTS -- PARAMETER MEANING
' Strng$ String to check for reliable
'
' OUTPUTS -- ZReliableMode Reliable mode indicator
'
' PURPOSE -- To test for reliable connect
'
SUB TestRel (Strng$) STATIC
ZReliableMode = ZFalse
IF Strng$ = "" THEN _
EXIT SUB
IF INSTR(Strng$,"REL") OR _
INSTR(Strng$,"R C") OR _
INSTR(Strng$,"ARQ") OR _
INSTR(Strng$,"LAP") OR _
INSTR(Strng$,"ECL") OR _
INSTR(Strng$,"AFT") OR _
* ------[ first line different ]------
INSTR(Strng$," EC") OR _ 'Bc022393
INSTR(Strng$,"MNP") THEN _
ZReliableMode = -1
ZWasZ = INSTR(Strng$,"ARRIER ")
IF ZWasZ > 0 THEN _
IF VAL(MID$(Strng$,ZWasZ+6)) > 0 THEN _
ZCBaud$ = STR$(VAL(MID$(Strng$,ZWasZ+6))) : _
CALL Trim (ZCBaud$)
END SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
675 Call GetRBBSString(278,RBBSString$) 'Pe 01/29/93
ZOutTxt$ = RBBSString$
ZHidden = ZTrue
CALL PopCmdStack
IF ZSubParm < 0 THEN _
ZPswdFailed = ZTrue : _
EXIT SUB
ZHidden = ZFalse
ZWasZ$ = ZUserIn$
* REPLACING old line(s) by new
* ------[ first line different ]------
680 Call GetRBBSString(65,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$)
ZLastIndex = 0
IF NOT ZMsgPswd THEN _
CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
GOTO 670
END SUB
* REPLACING old line(s) by new
949 ZLine25$ = "Node " + _
* ------[ first line different ]------
ZNodeID$ + " " + _
ZPageStatus$ + " " + _
MID$("HOUR ",1, -5 * ZSysopAvail) + _ 'ST081501
MID$("PAGE ",1, -5 * ZSysopAnnoy) + _ 'ST081501
MID$("PNT ",1, -4 * ZPrinter) + _ 'ST081501
MID$("SYS ",1, -4 * ZSysopNext) + _
MID$("XOFF ",1,-5 * ZXOffEd) + _
MID$("CTS ",1,-4 * ZNotCTS)
'
'
' * LINE 25 UPDATE ROUTINE
'
'
* REPLACING old line(s) by new
950 IF NOT ZSnoop THEN _
EXIT SUB
ZCursorLine = CSRLIN
ZCursorRow = POS(0)
ZWasHH = LEN(ZActiveUserName$) + _
LEN(ZWasCI$) + _
LEN(ZLine25$) + _
* ------[ first line different ]------
LEN(STR$(ZUserSecLevel))+ _
LEN(STR$(INT(MinsRemaining))) + 2 'Pe 05/29/91
LOCATE 25,1
IF ZNetworkType = 0 THEN _
ZLockStatus$ = SPACE$(2) + _ 'Pe 05/29/91
LEFT$(ZTimeLoggedOn$,5) 'Pe 05/29/91
IF ZWasHH > 63 THEN _
ZWasHH = 0 _
ELSE _
ZWasHH = 64 - ZWasHH
ZLine25Hold$ = ZLine25$ + _
SPACE$(ZWasHH) + _
STR$(ZUserSecLevel) + _
" " + _
ZActiveUserName$ + _
" " + _
ZWasCI$ + _
" " + _
STR$(INT(MinsRemaining)) + _ 'Dgs-008
" " + _
ZLockStatus$
ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$
IF ZDosANSI THEN _
ZLine25Hold$ = ZColorReset$ + ZLine25Hold$ + ZEmphasizeOff$
CALL LPrnt(ZLine25Hold$,0)
LOCATE ZCursorLine,ZCursorRow
END SUB
* REPLACING old line(s) by new
1336 IF NOT ZOK THEN _
* ------[ first line different ]------
Call GetRBBSString(279,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ + _
ZWasZ$ : _
CALL QuickTPut1 (ZOutTxt$) : _
CALL UpdtCalr (ZOutTxt$,2)
ZAnsIndex = ZAnsIndex + 1
IF ZAnsIndex <= ZLastIndex THEN _
GOTO 1332
IF FastHelp THEN _
FastHelp = ZFalse : _
EXIT SUB
GOTO 1331
* REPLACING old line(s) by new
1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
' $PAGE
'
' NAME -- SecViolation
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- ZCursorLine CURRENT LINE ON SCREEN
' ZCursorRow CURRENT ROW ON ZCursorLine
'
' PURPOSE -- Inform caller of security violation, augment count of
' violations and determine whether too many occurred.
'
SUB SecViolation STATIC
CALL FlushKeys
CALL BufFile (ZSecVioHelp$,WasX)
IF NOT ZOK THEN _
* ------[ first line different ]------
Call GetRBBSString(66,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 ( ZFirstName$ + OutTxt$)
CALL UpdtCalr ("SV!-" + ZViolation$,2)
ZLastIndex = 0
ZViolationsThisSession = ZViolationsThisSession + 1
IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
EXIT SUB
* REPLACING old line(s) by new
1385 IF ZUserFileIndex < 1 THEN _
EXIT SUB
* ------[ first line different ]------
Call GetRBBSString(280,RBBSString$) 'Pe 01/26/93
ZOutTxt$ = RBBSString$ 'Pe 01/26/93
IF ZUserSecLevel <= ZMinLogonSec THEN _
ZOutTxt$ = "" : _
ZUserSecLevel = ZUserSecLevel - 1 _
ELSE ZUserSecLevel = ZMinLogonSec
ZDenyAccess = ZTrue
END SUB
* REPLACING old line(s) by new
1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
' $PAGE
'
' NAME -- DenyAccess
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- (USER'S RECORD)
'
' PURPOSE -- Permanently resets user's security level when access denied
'
SUB DenyAccess STATIC
CALL TPut
ZLogonErrorIndex = 5
ZSubParm = 6
CALL FileLock
CALL OpenUser (ZHighestUserRecord)
FIELD 5, 128 AS ZUserRecord$
GET 5,ZUserFileIndex
MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
PUT 5,ZUserFileIndex
* ------[ first line different ]------
CALL MenuPlus (11) 'MENU1748
ZSubParm = 8
CALL FileLock
END SUB
* REPLACING old line(s) by new
1430 IF ZWasY$ = "" THEN _
GOTO 1435
ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
GOSUB 1476
* ------[ first line different ]------
GOTO 1435
* REPLACING old line(s) by new
1480 ' $SUBTITLE: 'LPrnt - subroutine to write to display'
' $PAGE
'
' NAME -- LPrnt
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO WRITE OUT
' NumReturns NUMBER OF CARRIAGE RETURNS
'
' OUTPUTS -- NONE
'
' PURPOSE -- Subroutine to write to the display.
'
SUB LPrnt (Strng$,NumReturns) STATIC
IF NOT ZSnoop THEN _
EXIT SUB
CALL PScrn (Strng$)
* ------[ first line different ]------
IF ZUseBASICWrites THEN _
FOR WasI = 1 TO NumReturns : _
PRINT : _
NEXT : _
ELSE FOR WasI = 1 TO NumReturns : _
LOCATE ,,1 : _
CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
LOCATE ZWasCL,ZWasCC : _
NEXT
END SUB
* REPLACING old line(s) by new
1534 ZUserIn$ = ZOutTxt$ ' Not Macro command - pass to normal processing
* ------[ first line different ]------
' * strip off leading slash when not in turbokey mode so macros can be
' * written to work in both turbo and non-turbo-key mode
IF LEFT$(ZUserIn$,1) = "/" THEN IF NOT ZTurboKeyUser THEN _ ' KG092301
ZUserIn$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-1) : _ ' KG092301
ZTurboKey = ZFalse ' KG092301
IF ZMacroEcho THEN _
ZSubParm = 4 : _
CALL TPut
WasX$ = ZCarriageReturn$
GOTO 1547
* REPLACING old line(s) by new
1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
IF TempElapsed! < 30 THEN _
IF TempElapsed! <= 0 THEN _
CALL SkipLine (1) : _
ZSubParm = -1 : _
ZNo = ZTrue : _
ZRet = ZTrue : _
ZSleepDisconnect = NOT ZAutoLogoffReq : _
IF ZAutoLogoffReq THEN _
CALL UpdtCalr ("Auto-logoff",1): _
EXIT SUB _
ELSE CALL UpdtCalr ("Sleep disconnect",1) : _
EXIT SUB _
ELSE IF SleepWarn THEN _
SleepWarn = ZFalse : _
Temp! = TempElapsed! : _
* ------[ first line different ]------
Call GetRBBSString(281,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
CALL RingCaller : _
Call GetRBBSString(67,RBBSString$) : _ 'Pe 01/16/93
CALL QuickTput (RBBSString$ + " " ,0) _ 'Pe 10/20/91
ELSE IF Temp! - TempElapsed! > 1.0 THEN _
CALL QuickTPut (ZBackSpace$+ZBackSpace$,0) : _
CALL QuickTPut (RIGHT$(STR$(CINT(TempElapsed!)),2),0) : _
Temp! = TempElapsed!
CALL FindFKey
IF ZSubParm < 0 THEN _
EXIT SUB
* REPLACING old line(s) by new
1545 WasX$ = ZWasY$
ZAutoLogoffReq = ZFalse
* ------[ first line different ]------
'ZAutoEnd = 0 'Pe 10/21/91
IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
GOTO 1635
IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
GOTO 1525
IF ZWasY$ = "^" THEN _
GOTO 1525
IF ZWasY$ = ZCarriageReturn$ THEN _
GOTO 1547 _
ELSE GOSUB 1550
IF ZTurboKey < 1 THEN _
GOTO 1546
IF ZWasY$ = " " THEN _
ZWasY$ = ""
IF ZWasY$ <> "/" THEN _
ZUserIn$ = ZWasY$ : _
ZWasY$ = ZCarriageReturn$ : _
WasX$ = ZWasY$ : _
GOTO 1547
ZTurboKey = 0
GOTO 1525
* REPLACING old line(s) by new
1546 IF LEN(ZUserIn$) => 512 THEN _
* ------[ first line different ]------
Call GetRBBSString(282,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
ZSubParm = 5 : _
CALL TPut : _
ZWasY$ = ZCarriageReturn$ : _
WasX$ = ZWasY$ : _
GOTO 1547
ZUserIn$ = ZUserIn$ + _
ZWasY$
GOTO 1525
* REPLACING old line(s) by new
1550 IF ZLogonActive THEN _
GOSUB 1549 : _
ZHidden = (Temp = 2 - (ZLenIndiv > 0 AND ZStartIndiv > 0))
IF ZHidden THEN _
IF (WasX$ <> " " AND WasX$ <> ";") THEN _
WasX$ = "."
CALL LPrnt(WasX$,0)
* ------[ first line different ]------
GOTO 1551
IF ZHidden AND (WasX$ <> " ") THEN _
WasX$ = "."
CALL LPrnt(WasX$,0)
* REPLACING old line(s) by new
1575 IF LEN(ZUserIn$) > 4000 THEN _
* ------[ first line different ]------
Call GetRBBSString(283,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ + ZFirstName$ : _ 'Pe 01/26/93
ZSubParm = 5 : _
CALL TPut : _
IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
EXIT SUB _
ELSE GOTO 1500
IF ZParseOff THEN _
ZParseOff = ZFalse : _
GOTO 1620
CALL ParseIt
IF ZWasQ = 1 THEN _
GOTO 1622
GOTO 1625
* REPLACING old line(s) by new
1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
IF ZAutoLogoffReq OR ZWaitExpired THEN _
ZWaitExpired = ZFalse : _
IF NOT ZSuspendAutologoff THEN _
* ------[ first line different ]------
ZAutoLogoff! = TIMER + 15 'Pe 10/20/91
RETURN
* REPLACING old line(s) by new
1625 IF LEN(ZUserIn$) < 4 THEN _
WasX$ = LEFT$(ZUserIn$,3): _
CALL AllCaps (WasX$) : _
ZYes = (INSTR("YES",WasX$) = 1) : _
* ------[ first line different ]------
ZNo = (INSTR("NO",WasX$) = 1 OR WasX$ = "A" OR WasX$ = "Q") : _
ZReply = (WasX$ = "RE") OR ZReply : _
ZKillMessage = (WasX$ = "K") OR ZKillMessage
ZHidden = ZFalse
* REPLACING old line(s) by new
1628 CALL VerifyAns
IF NOT ZOK THEN _
* ------[ first line different ]------
Call GetRBBSString(68,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$+ ZUserIn$(1) + ">") : _
GOTO 1500
HoldA$ = ""
ZForceKeyboard = ZFalse
IF ZMacroSave > 0 THEN _
ZGSRAra$(ZMacroSave) = ZUserIn$ : _
ZMacroSave = 0 : _
GOTO 1632
IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
CALL WipeLine (38) : _
IF NOT ZNo THEN _
GOTO 1632 _
ELSE ZWasQ = 0 : _
ZMacroTemplate$ = "" : _
ZDistantTGet = 0 : _
ZNo = ZFalse : _
GOTO 1633
IF ZMacroActive THEN _
ZLastIndex = ZWasQ : _
FirstIndex = 1: _
ZMacroActive = NOT EOF(6) : _
EXIT SUB
IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
EXIT SUB
IF MacroIndex OR ZSubParm < 3 THEN _
MacroIndex = 1 _
ELSE MacroIndex = ZAnsIndex
CALL NoPath (ZUserIn$(MacroIndex),Found)
IF Found THEN _
EXIT SUB
CALL CheckMacro (ZUserIn$(MacroIndex),Found)
IF Found THEN _
ZStoreParseAt = ZAnsIndex : _
GOTO 1525
EXIT SUB
* REPLACING old line(s) by new
1638 ZWasDF$ = ZUserIn$
CALL AllCaps (ZWasDF$)
IF ZWasDF$ = "NS" THEN _
ZUserIn$ = "C" : _
ZNonStop = ZTrue
ZUserIn$(ZStoreParseAt) = ZUserIn$
ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
* ------[ first line different ]------
IF ZAutoEnd = 3 THEN _ 'Pe 10/20/91
ZNonStop = ZFalse 'Pe 10/20/91
GOTO 1642
* REPLACING old line(s) by new
1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
ZWasC = ZWasB-ZWasA
IF ZWasC < 1 THEN _
ZEOL = ZTrue : _
ZWasC = 128
ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
IF ZWasDF$ = "" THEN GOTO 1641
ZWasQ = ZWasQ + 1
ZStoreParseAt = ZStoreParseAt + 1
ZUserIn$(ZStoreParseAt) = ZWasDF$
CALL AllCaps(ZWasDF$)
WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";")
IF WasX = 0 THEN GOTO 1641
ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC)
IF ZStoreParseAt > 1 THEN IF INSTR("Jj",ZUserIn$(ZStoreParseAt-1)) THEN _
ZNonStop = (ZPageLength < 1)
* ------[ first line different ]------
IF ZAutoEnd = 3 THEN _ 'Pe 10/20/91
ZNonStop = ZFalse 'Pe 10/20/91
ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4)
IF ZAutoLogoffReq THEN _
Call GetRBBSString(69,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$)
IF ZWasQ > 0 AND WasX < 7 THEN _
ZWasQ = ZWasQ - 1 : _
ZStoreParseAt = ZStoreParseAt - 1
* REPLACING old line(s) by new
1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
' $PAGE
'
' NAME -- SetBaud
'
' INPUTS -- PARAMETER MEANING
' ZBaudRateDivisor NUMBER TO DIVIDE THE 8250 CHIP'S
' PROGRAMABLE CLOCK TO ADJUST THE
' BAUD RATE TO THE USER'S BAUD
' RATE (INDEPENDENT OF THE BAUD
' RATE USED TO OPEN THE COMM. PORT)
'
' DESIRED BAUD DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
' RATE PCjr PC AND XT
' 50 2237 2304
' 75 1491 1536
' 110 1017 1047
' 134.5 832 857
' 150 746 768
' 300 373 384
' 600 186 192
' 1200 93 96
' 1800 62 64
' 2000 56 58
' 2400 47 48
' 3600 31 32
' 4800 23 24
' 7200 not available 16
' 9600 not available 12
* ------[ first line different ]------
' 14400 not available 8
' 19200 not available 6
' 38400 " 3
' OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
'
' PURPOSE -- To set the baud rate in the RS232 interface
' inpependent of the baud rate the communications port
' was opened at
'
SUB SetBaud STATIC
IF ZCBaud$ = "" THEN _
ZCBaud$ = MID$(ZBaudRates$,(-5 * ZBPS),5) : _ ' BH070401
CALL Trim (ZCBaud$) ' BH070401
Temp! = VAL(ZCBaud$)
IF Temp! > 0 THEN CALL SetBPS (Temp!,ZCBPS)
IF (ZCBPS = 0 OR Temp! = 0) THEN ZCBPS = ZBPS
IF NOT ZKeepInitBaud THEN _
ZTalkToModemAt$ = MID$(ZBaudRates$,(-5 * ZBPS),5) _
ELSE ZTalkToModemAt$ = ZModemInitBaud$
CALL Trim (ZTalkToModemAt$)
IF LEN(ZTalkToModemAt$) < 5 THEN _
ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
ZTalkToModemAt$
IF ZEightBit THEN_
Parity = 2 : _ ' No PARITY
DataBits = 3 : _ ' 8 DATA BITS
StopBits = 0 _ ' 1 STOP BIT
ELSE Parity = 3 : _ ' EVEN PARITY
DataBits = 2 : _ ' 7 DATA BITS
StopBits = 0 ' 1 STOP BIT
ComSpeed! = VAL(ZTalkToModemAt$)
IF ComSpeed! > 19200 THEN _
IF ZFossil THEN _
WasI = &H9600 _
ELSE WasI = 19200 _
ELSE WasI = ComSpeed!
IF ZFossil THEN _
CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
EXIT SUB
IF ComSpeed! = 2400 THEN _
ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
ELSE IF ComSpeed! = 1200 THEN _
ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
ELSE IF ComSpeed! = 9600 THEN _
ZBaudRateDivisor = &HC _
ELSE IF ComSpeed! = 300 THEN _
ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
ELSE IF ComSpeed! = 450 THEN _
ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
ELSE IF ComSpeed! = 4800 THEN _
ZBaudRateDivisor = &H18 _
ELSE IF ComSpeed! = 19200 THEN _
ZBaudRateDivisor = &H6 _
ELSE IF ComSpeed! = 38400 THEN _
ZBaudRateDivisor = &H3
MostSignifByte = FIX (ZBaudRateDivisor / 256)
LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
LineCntlStatus = INP(ZLineCntlReg)
MSBSave = INP(ZMSB)
OUT ZMSB,0
OUT ZLineCntlReg,LineCntlStatus OR 128
OUT ZLSB,LeastSignifByte
OUT ZMSB,MostSignifByte
OUT ZLineCntlReg,LineCntlStatus
OUT ZMSB,MSBSave
END SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
2021 ZOutTxt$ = "To [All],S)ysop," + _ ' Mpl090202
LEFT$("D)istribution,",-14*EnableCC) + _
" or Full or Partial Name" ' DD073101
CALL SkipLine (1)
ZSemiOnly = ZTrue
CALL PopCmdStack
IF NOT ZSysop THEN _ 'SM091908
CALL SmartText(ZUserIn$,ZFalse,ZFalse,ZFalse) 'Pe 02/06/93
IF LEN(ZUserIn$(ZAnsIndex)) > 30 THEN _
Call GetRBBSString(23,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$) : _
GOTO 2021
Found = ZTrue
IF ZWasQ = 0 THEN _
MsgTo$ = "ALL" : _ 'Pe 12/08/91
GOTO 2032 _ 'Pe 12/08/91
ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _
CALL AllCaps (ZWasDF$) : _
CALL Trim (ZWasDF$) : _ ' DD082301
ZUserIn$(ZAnsIndex) = ZWasDF$ : _
MsgTo$ = ZWasDF$ : _ 'Pe Efnd mod
IF ZWasDF$ = "A" THEN _
MsgTo$ = "ALL" _
ELSE IF ZWasDF$ = "S" THEN _
MsgTo$ = ZSysopFirstName$ + " " +ZSysopLastName$ _ 'TS 04/14/09
ELSE IF ZWasDF$ = "D" AND EnableCC THEN _
GOTO 2025 _
ELSE MsgTo$ = ZWasDF$
GOTO 2032
* REPLACING old line(s) by new
* ------[ first line different ]------
2025 Call GetRBBSString(284,RBBSString$) 'Pe 01/26/93
ZOutTxt$ = RBBSString$ 'Pe 01/26/93
CALL PopCmdStack
IF ZWasQ = 0 THEN _
GOTO 2021
ZFileName$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (ZFileName$)
IF INSTR("?H",ZFileName$) > 0 THEN _
GOTO 2024
CALL BadFile (ZFileName$,BadFileNameIndex)
ON BadFileNameIndex GOTO 2026,2025,2025
* REPLACING old line(s) by new
2026 ZFileName$ = ZDistriPath$ + ZFileName$ + ".LST"
CALL FindItX (ZFileName$,7)
IF NOT ZOK THEN _
* ------[ first line different ]------
Call GetRBBSString(70,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPUT1 (ZUserIn$ + OutTxt$) : _
ZMplPersUpload = ZFalse : _
GOTO 2024
ZNumHeaders = 0
ZMplPersUpload = ZTrue 'Mpl090202
CALL OpenWorkA (ZNodeWorkFile$)
WHILE NOT EOF(7)
CALL ReadDir (7,1)
CALL AllCaps (ZOutTxt$)
ZWasDF$ = ZOutTxt$
CALL WhoCheck (ZOutTxt$, Found, RcvrRecNum)
ZNumHeaders = ZNumHeaders + 1
CALL PrintWorkA (ZWasDF$ + "," + STR$(-RcvrRecNum*Found))
WEND
GOTO 2033
* REPLACING old line(s) by new
2032 RcvrRecNum = 0
* ------[ first line different ]------
ZMplPersUpload = ZFalse 'Mpl090202
IF MsgTo$ <> "ALL" THEN _
IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
CALL CheckInt (MsgTo$) : _ ' KG082201
IF ZTestedIntValue = 0 OR ZUserSecLevel < ZSysOpSecLevel THEN _' DD012102
ZWasDF = INSTR(MsgTo$+" @"," @") : _
TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _
ZMplPersUpload = Ztrue : _ 'Pe 06/08/91
CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
CALL QuickPeek (ZUserIn$(ZAnsIndex),MsgTo$,Found): _ 'Pe Efnd mod
CALL AliasChk (MsgTo$,Found,UserNumFound) : _ 'Mpl-ALias2 IF MsgTo$ = "" THEN EXIT SUB : _ ' DD062502
IF NOT Found THEN _
ZLastIndex = 0 : _
RcvrRecNum = 0 : _
Call GetRBBSString(71,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (MsgTo$ + OutTxt$ +" " + _' Mpl090202
ZRBBSName$ + "!") : _ ' DD060101
ZMplPersUpload = ZFalse : _ 'Pe 06/08/91
IF NOT ZReply THEN _
Call GetRBBSString(285,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
ZTurboKey = -ZTurboKeyUser : _
ZLastIndex = 0 : _
GOSUB 2034 : _
IF NOT ZYes THEN _
MsgTo$ = "" : _ ' DD080301
EXIT SUB ' DD080301
CALL CheckInt (MsgTo$) ' DD012102
IF ZTestedIntValue > 1 AND ZUserSecLevel >= ZSysOpSecLevel THEN _' DD012102
ZMplPersUpload = ZTrue ' DD012102
IF MsgTo$ = Temp$ THEN _
Call GetRBBSString(286,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
ZLastIndex = 0 : _
GOSUB 2034 : _
IF NOT ZYes THEN _
MsgTo$ = ""
CALL OpenWorkA (ZNodeWorkFile$)
CALL PrintWorkA (MsgTo$ + "," + STR$(RcvrRecNum))
CLOSE 2
ZNumHeaders = ZNumHeaders + 1
IF EnableCC AND (NOT ZReply) AND MsgTo$ <> "ALL" AND _
MsgTo$ <> "" AND LEFT$(MsgTo$,4) <> "ALL " AND _
(NOT ZSysopComment) AND (NOT ZSysopMsg) THEN _
Call GetRBBSString(287,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
CALL PopCmdStack : _
IF ZYes THEN _
GOTO 2021
* REPLACING old line(s) by new
2075 IF MsgTo$ = "ALL" THEN _
* ------[ first line different ]------
Call GetRBBSString(72,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$) : _
GOTO 2060
IF ZWasZ$ = "P" THEN _
GOTO 2088
* REPLACING old line(s) by new
* ------[ first line different ]------
2081 Call GetRBBSString(73,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$ + " " + MsgTo$)
* REPLACING old line(s) by new
2085 ZOutTxt$ = "Password"
GOSUB 2096
IF ZWasQ = 0 THEN _
IF LEFT$(MsgPswd$,1) = "!" THEN _
MsgPswd$ = MID$(MsgPswd$,2) : _
* ------[ first line different ]------
Call GetRBBSString(74,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$ + " " + MsgPswd$) : _
RETURN _
ELSE _
GOTO 2085
IF LEN(ZUserIn$) > WasL THEN _
Call GetRBBSString(75,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (STR$(WasL) + OutTxt$) : _
GOTO 2085
IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
Call GetRBBSString(76,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$) : _
GOTO 2085
RETURN
'
' ** PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
'
* REPLACING old line(s) by new
* ------[ first line different ]------
2088 Call GetRBBSString(288,RBBSString$) 'Pe 01/26/93
ZOutTxt$ = RBBSString$ 'Pe 01/26/93
ZTurboKey = -ZTurboKeyUser
GOSUB 2096
IF NOT ZYes THEN _
GOTO 2070
WasL = 14
WasA1$ = "!"
GOSUB 2085
CALL AllCaps (ZUserIn$)
GOTO 2092
'
' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
'
* REPLACING old line(s) by new
2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
' $PAGE
'
' NAME -- WhoCheck
'
' INPUTS -- PARAMETER MEANING
' WhoFind$ User to find
'
' OUTPUTS -- WhoFound Whether user found
' UserNumFound Record # of user
'
' PURPOSE -- Validate that user record exists. Sysop
' counted as found even if lack user record.
'
SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
UserNumFound = 0
IF ZStartHash <> 1 THEN _
WhoFound = ZTrue : _
EXIT SUB
Work128$ = ZUserRecord$
WhoFound = ZFalse
ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0)
* ------[ first line different ]------
CALL OpenUser (ZHighestUserRecord)
FIELD 5, 128 AS ZUserRecord$
IF ToSysop THEN _
WasX$ = ZSecretName$ : _
Call MenuPlus (4) _ ' Pe Menu174
ELSE WasX$ = WhoFind$
ZWasDF = INSTR(WasX$+"@","@")
WasX$ = LEFT$(WasX$,ZWasDF)
IF LEN(WasX$) > 1 THEN _
CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
0,0,ZHighestUserRecord,WhoFound,_
UserNumFound,ZWasSL)
LSET ZUserRecord$ = Work128$
IF NOT WhoFound THEN _
IF ToSysop THEN _
WhoFound = ZTrue
END SUB
* REPLACING old line(s) by new
2620 ZOutTxt$ = "Line #" + _
STR$(WasL) + _
" is:" + _
ZReturnLineFeed$ + _
ZOutTxt$(WasL)
ZSubParm = 3
CALL TPut
GOSUB 2695
IF NOT ZExpertUser THEN _
* ------[ first line different ]------
Call GetRBBSString(77,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$)
ZOutTxt$ = "Search for" + _
ZPressEnterExpert$
ZMacroMin = 99
ZParseOff = ZTrue
ZSubParm = 1
GOSUB 2694
IF ZWasQ = 0 THEN _
EXIT SUB
ZWasY$ = LEFT$(ZUserIn$,1)
IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
IF LEN(ZUserIn$) > 2 THEN _
WasX = INSTR(2,ZUserIn$,ZWasY$) : _
IF WasX < LEN(ZUserIn$) THEN _
IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
WasX = WasX - 1 : _
GOTO 2622
WasX = INSTR(ZUserIn$,";")
* REPLACING old line(s) by new
2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
IF WasX = 0 THEN _
* ------[ first line different ]------
Call GetRBBSString(78,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 ("<" + WasX$ + OutTxt$ + STR$(WasL)) : _
GOTO 2620
* REPLACING old line(s) by new
3730 IF TabToSpace > 0 THEN _
WasX$ = " " : _
TabToSpace = TabToSpace - 1 : _
GOTO 3750
CALL FindFKey
IF ZSubParm < 0 THEN _
EXIT SUB
WasX$ = ZKeyPressed$
IF WasX$ = "" THEN _
* ------[ first line different ]------
GOTO 3732 : _ ' KG011201
IF ZLocalUser THEN _
GOTO 3733 _
ELSE GOTO 3732
IF WasX$ = ZEscape$ THEN _
ZKeyPressed$ = WasX$ : _
EXIT SUB
SendRemote = ZTrue
WasZ = INSTR(ZLineEditChk$,WasX$)
IF WasZ < 1 THEN _
GOTO 3750 _
ELSE IF WasZ > 4 THEN _
GOTO 3870 _
ELSE IF WasZ = 1 THEN _
GOTO 3810
IF ZLocalUser THEN _
GOTO 3730
* REPLACING old line(s) by new
3732 IF ZCommPortStack$ <> "" THEN _
WasX$ = LEFT$(ZCommPortStack$,1) : _
ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
GOTO 3738
* ------[ first line different ]------
IF NOT ZLocalUser THEN _ ' KG011201
CALL EofComm (Char) : _ ' KG011201
IF Char <> -1 THEN _ ' KG011201
GOTO 3736 ' KG011201
* REPLACING old line(s) by new
3750 IF SendRemote THEN _
CALL PutCom(WasX$)
* ------[ first line different ]------
IF WasX$ = ZCarriageReturn$ THEN _
CALL LPrnt (ZCrLf$,0) : _
Col = Col - 1 : _
GOTO 3850 _
ELSE _
CALL LPrnt (WasX$, 0)
* REPLACING old line(s) by new
3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
' $PAGE
'
' NAME -- KillMsg
'
' INPUTS -- PARAMETER MEANING
' MsgToKill MESSAGE NUMBER TO KILL
' ActiveMessages NUMBER ACTIVE MESSAGES
'
' OUTPUTS -- NONE
'
' PURPOSE -- To kill/delete old or unnecessary messages
'
* ------[ first line different ]------
SUB KillMsg (MsgToKill,ActiveMessages,ZconfName$) STATIC 'Pe 05/29/91
FIELD #1,128 AS ZMsgRec$
WasQX = 1
NumHeaders = 0
* REPLACING old line(s) by new
3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
CALL ChkMsgName (MsgFromCaller,MsgToCaller) : _
IF (MsgFromCaller OR MsgToCaller) THEN _
GOTO 4020 _
ELSE IF NumHeaders > 1 THEN _
GOTO 4032 _
ELSE ZMsgPswd = ZTrue : _
ZAttemptsAllowed = 0 : _
* ------[ first line different ]------
Call GetRBBSString(289,RBBSString$) : _ 'Pe 01/26/93
ZOutTxt$ = RBBSString$ : _ 'Pe 01/26/93
GOTO 4031
* REPLACING old line(s) by new
* ------[ first line different ]------
4656 Call GetRBBSString(290,RBBSString$) 'Pe 01/26/93
ZOutTxt$ = RBBSString$ 'Pe 01/26/93
ZTurboKey = -ZTurboKeyUser
ZSubParm = 1
CALL TGet
IF ZWasQ = 0 OR ZSubParm = -1 THEN _
EXIT SUB
ZWasZ$ = ZUserIn$(1)
* REPLACING old line(s) by new
4777 ZWasCM = 0
CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
ZSecsPerSession! = ZSecsPerSession! + Elapsed!
IF NOT ZLocalUser THEN _
ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
* ------[ first line different ]------
Call GetRBBSString(79,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
CALL QuickTPut (OutTxt$,2)
END SUB
* REPLACING old line(s) by new
5500 ' $SUBTITLE: 'BankTime - Allows User to Bank Session Time'
' $PAGE
' NAME -- BankTime
'
' INPUTS -- PARAMETER MEANING
' ZBankTime Time in bank can use
'
' OUTPUTS -- ZBankTime
'
' PURPOSE -- Allow Users to use Bank session time
'
SUB BankTime STATIC
* ------[ first line different ]------
If ZUserSecLevel < ZOptSec(28) Then Exit Sub 'Pe 08/30/92
GOSUB 5507
* REPLACING old line(s) by new
5501 CALL TimeRemain(MinsRemaining)
* ------[ first line different ]------
Call GetRBBSString(291,RBBSString$) 'Pe 01/26/93
ZOutTxt$ = STR$(MinsRemaining) + RBBSString$
ZTurboKey = -ZTurboKeyUser
CALL PopCmdStack
IF ZSubParm = -1 THEN _
EXIT SUB
ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
CALL AllCaps(ZWasZ$)
ON INSTR("QDW?H",ZWasZ$) GOTO 5509,5505,5502,5508,5508
GOTO 5501
* REPLACING old line(s) by new
5503 IF SignTime = 1 THEN _
ZOutTxt$ = "Withdraw" _
* ------[ first line different ]------
ELSE ZOutTxt$ = "Deposit "
Temp$ = ZOutTxt$ + " how many mins"
CALL ChangeInt (ZFalse,Temp$,Temp,0,Maxtime)
IF ZWasQ = 0 OR ZTestedIntValue = 0 THEN _
GOTO 5501
ZTestedIntValue = SignTime * ZTestedIntValue
CALL ChkAddedTime (ZTestedIntValue)
IF ZTestedIntValue = 0 THEN _
GOTO 5501
CALL UpdtCalr (Left$(Temp$,8) + STR$(ZTestedIntValue) + " Mins " ,2) ' Pe 02/05/93
ZSecsPerSession! = ZSecsPerSession! + (ZTestedIntValue * 60)
IF ZMaxPerDay = 0 THEN _ ' KG082101
ZTimeCredits! = ZTimeCredits! + ZTestedIntValue * 60 ' KG082101
ZElapsedTime = ZElapsedTime - ZTestedIntValue
ZGlobalBankTime = ZGlobalBankTime - ZTestedIntValue
ZBankTime = ZGlobalBankTime 'Pe 11/02/91
GOSUB 5507
GOTO 5501
* REPLACING old line(s) by new
5505 SignTime = -1 ' deposit
MaxTime = ZMaxBank - ZGlobalBankTime
IF MaxTime <= 0 THEN _
* ------[ first line different ]------
Call GetRBBSString(80,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$ + STR$(ZMaxBank)) : _
ZLastIndex = 0 : _
GOTO 5501
IF MaxTime > MinsRemaining THEN _
MaxTime = MinsRemaining
GOTO 5503
* REPLACING old line(s) by new
5507 IF ZAnsIndex < ZLastIndex THEN _
RETURN
* ------[ first line different ]------
Call GetRBBSString(81,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
ZOutTxt$ = OutTxt$ +" " + _
STR$(ZGlobalBankTime) + " Mins"
CALL QuickTPut1(ZOutTxt$)
RETURN
* REPLACING old line(s) by new
5509 GOSUB 5507
* ------[ first line different ]------
END SUB
* REPLACING old line(s) by new
9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
' $PAGE
'
' NAME -- DefaultU
'
' INPUTS -- PARAMETER MEANING
* ------[ first line different ]------
' ZFullScreenEditor 'Pe 09/02/91 AnsiEd Mod
' ZBoldText$ Ansi bold (0 no, 1 yes)
' ZCheckBulletLogon
' ZExpertUser
' ZWasGR
' ZLastMsgRead
' ZLineFeeds
' ZNulls
' ZPageLength
' ZPromptBell
' ZRegDate$
' ZReqQuesAnswered
' ZRightMargin
' ZSkipFilesLogon
' ZTimesLoggedOn
' ZUpperCase
' ZUserOption$
' ZUserTextColor Ansi of color (31-37)
' ZUserXferDefault$
'
' OUTPUTS-- USER.OPTONS$
'
' PURPOSE -- To update the user's record with their options.
' Meaning of graphics preference stored is as follows: where # is
' value stored for the color. E.g. if graphics perference for text
' files is color, and preference for normal text is light yellow,
' graphics preference stored is 38. Colors are Red, Green, Yellow,
' Blue, Purple, Cyan, and White.
'
' normal bold
' Graphics R G Y B P C W R G Y B P C W
' none 30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
' ansi 31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
' color 32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
'
SUB DefaultU STATIC
ZWasA = -ZPromptBell -2 * ZExpertUser _
-4 * ZNulls -8 * ZUpperCase _
-16 * ZLineFeeds -32 * ZCheckBulletLogon _
-64 * ZSkipFilesLogon -128 * ZFullScreenEditor _
-256 * ZReqQuesAnswered -512 * ZMailWaiting _
-1024 * (NOT ZHiLiteOff) -2048 * ZTurboKeyUser _
-4096 * ZFileWaiting -8192 * ZAvailableForChat 'Rchat-Mpl
WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
IF WasX < 1 OR WasX > 255 THEN _
WasX = 48
LSET ZUserOption$ = _
MKI$(ZTimesLoggedOn) + _
MKI$(ZLastMsgRead) + _
ZUserXferDefault$ + _
CHR$(WasX) + _
MKI$(ZRightMargin) + _
MKI$(ZWasA) + _
ZRegDate$ + _
CHR$(ZPageLength) + _
ZEchoer$
END SUB
* REPLACING old line(s) by new
9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
' $PAGE
'
' NAME -- WhosOn
'
' INPUTS -- PARAMETER MEANING
' NumNodes # of nodes to check
' ZActiveMessageFile$ Current message file
' ZOrigMsgFile$ Main msg file
'
' OUTPUTS -- None
'
' PURPOSE -- To display who is on each node.
'
SUB WhosOn (NumNodes) STATIC
* ------[ first line different ]------
REDIM UserAlreadyOn$(ZMaxNodes)
WasA1$ = ZActiveMessageFile$
ZActiveMessageFile$ = ZOrigMsgFile$
CALL OpenMsg
FIELD 1, 128 AS ZMsgRec$
node = VAL(ZNodeId$)
UserAlreadyOn$(node) = Left$(ZActiveUserName$,26)
FOR NodeIndex = 2 TO NumNodes + 1
GET 1,NodeIndex
ZOutTxt$ = ZFG1$ + "Node" + _
STR$(NodeIndex - 1) + ZFG2$
RecIndex = -VAL(MID$(ZMsgRec$,44,2)) ' KG032604
IF RecIndex >= 0 THEN _
RecIndex = -1
WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
" BPS: "
IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
ZWasY$ = "SYSOP" + SPACE$(21) _
ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
WasAX$ = WasAX$ + ZFG3$ + ZWasY$
'* ------[ first line different ]------
IF MID$(ZMsgRec$,40,2) <> "-1" THEN ' CHAT0805
CALL SaveUserActivity(WhatTheyDoin$, NodeIndex, ZTrue) ' CHAT0813
IF WhatTheyDoin$ = "C" THEN ' CHAT0813
WasAX$ = WasAX$ + ZFG4$ + "(In Chat System)" ' CHAT0813
ELSEIF WhatTheyDOin$ = "F" THEN ' CHAT0813
WasAX$ = WasAX$ + ZFG4$ + "(In File System)" ' CHAT0813
ELSEIF WhatTheyDoin$ = "M" THEN ' CHAT0813
WasAX$ = WasAX$ + ZFG4$ + "(In Message System)" ' CHAT0813
ELSE ' CHAT0813
WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22) ' CHAT0813
END IF ' CHAT0813
ELSE ' CHAT0805
WasAX$ = WasAX$ + ZFG4$ + "(In a Door)" ' CHAT0805
END IF ' CHAT0805
IF MID$(ZMsgRec$,57,1) = "A" THEN _
ZOutTxt$ = ZOutTxt$ + " Online at " + _
WasAX$ _
ELSE ZOutTxt$ = ZOutTxt$ + _
" Offline at " + _
WasAX$
'Test code.......
' IF MID$(ZMsgRec$,57,1) = "A" THEN
' If UserAlreadyOn$(Node) = Mid$(ZMsgRec$,1,26) and node <> NodeIndex - 1 then
' ZSubParm = -8
' GOTO 9802
' END IF
' ZOutTxt$ = ZOutTxt$ + " Online at " + WasAX$
' ELSE ZOutTxt$ = ZOutTxt$ + " Offline at " + WasAX$
' END IF
'End Test
' IF MID$(ZMsgRec$,57,1) = "A" THEN _
' ZOutTxt$ = ZOutTxt$ + " Online at " + _
' WasAX$ _
' ELSE IF NOT ZSysop THEN _
' ZOutTxt$ = ZOutTxt$ + _
' " Waiting for next caller" _
' ELSE ZOutTxt$ = ZOutTxt$ + _
' " Offline at " + _
' WasAX$
CALL QuickTPut1 (ZOutTxt$)
CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
IF ZNo THEN _
NodeIndex = NumNodes + 2
NEXT
* INSERTING new line(s)
9802 ZActiveMessageFile$ = WasA1$
CALL QuickTPut (ZEmphasizeOff$,0)
END SUB
* REPLACING old line(s) by new
10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
' $PAGE
'
' NAME -- RecoverMsg
'
' INPUTS -- PARAMETER MEANING
' MsgToRecover MESSAGE NUMBER TO RECOVER
' FirstMsgRecord RECORD # FOR First MSG
'
' OUTPUTS -- ActionFlag SET TO 0 IF ERROR
' SET TO -1 IF No ERROR
'
' PURPOSE -- To recover deleted messages. Note that this is only
' possible if you have not compressed your message file
' using config.
'
* ------[ first line different ]------
SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) STATIC 'Pe 06/09/91
FIELD #1,128 AS ZMsgRec$
MsgRec = FirstMsgRecord
* REPLACING old line(s) by new
10604 GET 5,ZUserFileIndex
* ------[ first line different ]------
' IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
' ZUplds = ZGlobalUplds : _
' ZDnlds = ZGlobalDnlds : _
' ZDLToday! = ZGlobalDLToday! : _
' ZBytesToday! = ZGlobalBytesToday! : _
' ZDLBytes! = ZGlobalDLBytes! : _
' ZULBytes! = ZGlobalULBytes! : _
' ZBankTime = ZGlobalBankTime _
' ELSE ZBankTime = 0
IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
ZUplds = ZGlobalUplds : _
ZDnlds = ZGlobalDnlds : _
ZDLToday! = ZGlobalDLToday! : _
ZBytesToday! = ZGlobalBytesToday! : _
ZDLBytes! = ZGlobalDLBytes! : _
ZULBytes! = ZGlobalULBytes! : _
ZBankTime = ZGlobalBankTime
LSET ZBankTime$ = CHR$(ZBankTime)
LSET ZLastDateTimeOn$ = ZWasY$
LSET ZCityState$ = ZWasCI$
IF UpdateDefaults THEN _
CALL DefaultU
IF ZListDir THEN _
LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
CHR$(VAL(MID$(ZCurDate$,1,2))) + _
CHR$(VAL(MID$(ZCurDate$,4,2)))
* REPLACING old line(s) by new
10607 IF ZExitToDoors OR NOT LoggingOff THEN _
* ------[ first line different ]------
EXIT SUB
CALL QuickTPut1 (ZCrLF$ +ZFG1$ + STR$(MinsRemaining)+ ZFG2$ + _
" min left Today" +ZCrLF$ +" Banked Time. " + ZFG1$+_
STR$(ZGlobalBankTime) + ZFG2$+" minutes.")
Call QuickTput1 (ZFG3$ +" "+ ZFirstName$ + ZFG2$ + ", Thanks for calling "+_
ZFG1$ +" " + ZOrigRBBSName$ +ZFG2$ +" please call again!" + _
ZColorReset$)
CALL DelayTime (8 + ZBPS)
Call MenuPlus (5) ' Pe Menu174
END SUB
* REPLACING old line(s) by new
10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
' $PAGE
' NAME -- DosExit
'
' INPUTS -- PARAMETER MEANING
' ZComPort$
' ZDoorsTermType
' ZMultiLinkPresent
' ZRBBSBat$
' ZRedirectIOMethod
' ZUseDeviceDriver$
'
' OUTPUTS -- ZWasQ NUMBER OF LINES TO WRITE OUT TO
' ZRCTTYBat$
' ZUserIn$() LINES TO WRITE OUT TO ZRCTTYBat$
'
' PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
' exit to DOS for the remote RBBS-PC sysop
'
SUB DosExit STATIC
* ------[ first line different ]------
* INSERTING new line(s)
10940 Call GetRBBSString(292,RBBSString$) 'Pe 01/16/93
ZOutTxt$ = RBBSString$ 'Pe 01/16/93
ZTurboKey = -ZTurboKeyUser
CALL TGet
CALL AllCaps (ZUserIn$)
IF ZYES THEN_
GOTO 10955
'
ZOutTxt$(1) = "ECHO OFF"
IF ZUseDeviceDriver$ <> "" THEN _
Port$ = ZUseDeviceDriver$ _
ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
IF ZRedirectIOMethod THEN _
ZFF = 5 : _
ZOutTxt$(2) = "CTTY " + _
Port$ : _
ZOutTxt$(3) = ZDiskForDos$ + _
"COMMAND" : _
ZOutTxt$(4) = "CTTY CON" : _
ZOutTxt$(5) = ZRBBSBat$ _
ELSE ZFF = 3 : _
ZOutTxt$(2) = ZDiskForDos$ + _
"COMMAND >" + _
Port$ + _
" <" + _
Port$ : _
ZOutTxt$(3) = ZRBBSBat$
* REPLACING old line(s) by new
10950 CALL AMorPM
* ------[ first line different ]------
CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
Call GetRBBSString(82,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
CALL QuickTPut1 ("RBBS-PC " + ZVersionID$ + ZCrLF$ + OutTxt$)
CALL RBBSExit (ZOutTxt$(),ZFF)
'
* INSERTING new line(s)
10955 Call GetRBBSString(83,RBBSString$) 'Pe 01/16/93
ZOutTxt$ = RBBSString$ 'Pe 01/16/93
CALL TGet
CALL AllCaps (ZUserIn$)
IF ZUserIn$ = "" or ZWasQ = 0 then_
GOTO 10940
Call Findit(ZUserIn$) 'Pe 12/28/92
If NOT ZOK then _ 'Pe 12/28/92
Call GetRBBSString(84,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
Call QuickTput ( OutTxt$ + " " + ZUserIn$ ,2)
GOTO 10940 'Pe 12/28/92
ZWasZ$ = ZUserIn$
CALL DoorExit (ZFalse)
END SUB
* REPLACING old line(s) by new
* ------[ first line different ]------
10985 CALL ReadParms (ZOutTxt$(),10,1) 'Pe 01/30/93 ' DD011801/DOORCARRIERDROP
IF ZErrCode > 0 THEN _
IF ReqDoorsDef THEN _
EXIT SUB _
ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
GOTO 10989
IF ExitTo$ <> ZOutTxt$(1) THEN _
GOTO 10985
CALL CheckInt (ZOutTxt$(2))
IF ZErrCode > 0 THEN _
ZErrCode = 0 : _
GOTO 10985
IF ZUserSecLevel < ZTestedIntValue THEN _
Call GetRBBSString(85,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$) : _
EXIT SUB
WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 10986
ZFileName$ = ZOutTxt$(3)
ExitMethod$ = ZOutTxt$(4)
ExitTemplate$ = ZOutTxt$(5)
ZDoorDisplay$ = ZOutTxt$(7)
ZDoorTime$ = ZOutTxt$(8) 'Pe 021293
ZDoorDropFile$ = ZOutTxt$(9) ' DD121702/DOORS
ZDoorCarrierDropOK$ = ZOutTxt$(10) ' DD011801/DOORCARRIERDROP
CALL AskUsers
CALL SmartText (ExitTemplate$,ZFalse,ZFalse,ZFalse) 'Pe 02/06/93
CALL MetaGSR (ExitTemplate$,ZFalse)
ExitTo$ = ExitTemplate$
GOTO 10989
* REPLACING old line(s) by new
10989 IF ZTransferFunction = 3 THEN _
ZWasY$ = "Registration" _
ELSE ZWasY$ = ZDooredTo$
* ------[ first line different ]------
ZOutTxt$ = " Swapping " +ZOrigRBBSName$ + " out and " + _
ZWasY$ + _
" door in... "
ZSubParm = 5
CALL TPut
CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
CALL DoorInfo
IF ExitMethod$ = "S" THEN _
CALL UpdateU (ZFalse) : _
Call SaveProf (3) : _ 'Pe 07/12/92
CLOSE 4,5 : _
CALL ShellExit (ExitTemplate$) : _
ZPrevCaller$ = "" : _
CALL SetCall : _
CALL DoorReturn : _
CALL BufFile (ZDoorDisplay$,WasX) : _
ZExitToDoors = ZFalse _
ELSE ZOutTxt$(1) = ZDiskForDos$ + _
"COMMAND /C " + _
ExitTo$ : _
ZOutTxt$(2) = ZRBBSBat$ : _
CALL RBBSExit (ZOutTxt$(),2)
END SUB
* REPLACING old line(s) by new
10991 ' $SUBTITLE: 'DoorInfo -- Write info for doors to file'
SUB DoorInfo STATIC
CLOSE 2
OPEN "O",2,"DORINFO" + _
ZNodeFileID$ + _
".DEF"
PRINT #2,ZRBBSName$
PRINT #2,ZSysopFirstName$
PRINT #2,ZSysopLastName$
IF ZLocalUser THEN _
PRINT #2,"COM0" _
ELSE PRINT #2,ZComPort$
* ------[ first line different ]------
ZUserIn$ = MID$(ZBaudParity$, INSTR(ZBaudParity$, ",")) ' MB040401
PRINT #2,ZTalkToModemAt$;" BAUD";ZUserIn$ ' KG071101
PRINT #2,ZNetworkType
IF ZGlobalSysop THEN _
PRINT #2,"SYSOP" : _
PRINT #2,"" _
ELSE PRINT #2,OrigFirstName$ : _ 'Lk Alias fix
PRINT #2,ZLastName$
PRINT #2,ZCityState$
PRINT #2,ZWasGR
PRINT #2,ZUserSecLevel
CALL TimeRemain (MinsRemaining)
CALL CheckInt (ZDoorTime$) 'Pe021293
IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
IF MinsRemaining > ZTestedIntValue THEN _
MinsRemaining = ZTestedIntValue
IF ZDoorTime$ = "" THEN _ 'Pe021293
ZDoorTime$ = STR$(INT(MinsRemaining)): _ 'Pe021293
Call Trim(ZDoorTime$) 'Pe021293
PRINT #2,INT(MinsRemaining)
PRINT #2,ZFossil
CLOSE 2
IF ZDoorDropFile$ = "R" OR ZDoorDropFile$ = "S" THEN _ ' DD012702/DOORS
CALL DoorSys : _ ' DD121702/DOORS
Exit Sub
IF ZDoorDropFile$ = "P" THEN _ ' DD121702/DOORS
CALL PCBoardSys : _ ' DD121702/DOORS
Exit Sub
IF ZDoorDropFile$ = "W" THEN _ ' DD121702/DOORS
CALL CallInfoBBS : _ ' DD121702/DOORS
Exit Sub
END SUB
* REPLACING old line(s) by new
10994 CLOSE 3
ZExitToDoors = ZTrue
IF NOT ZFossil THEN _
OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
* ------[ first line different ]------
* REPLACING old line(s) by new
12880 ZParseOff = ZTrue
ZOutTxt$ = Ques$
CALL PopCmdStack
IF ZSubParm = -1 THEN _
GOTO 12882
IF ZWasQ = 0 THEN _
GOTO 12880
IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
ZLastIndex = 0 : _
* ------[ first line different ]------
Call GetRBBSString(75,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (STR$(MaxLen) + OutTxt$) : _
GOTO 12880_
ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
ZLastIndex = 0 : _
Call GetRBBSString(86,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (STR$(MinLen) + OutTxt$) : _
GOTO 12880
Ans$ = ZUserIn$(ZAnsIndex)
IF ZAnsIndex < ZLastIndex THEN _
GOTO 12881
ZOutTxt$ = ZUserIn$(ZAnsIndex) + _
", right ([Y],N)"
ZTurboKey = -ZTurboKeyUser
ZSubParm = 1
CALL TGet
IF ZSubParm = -1 THEN _
GOTO 12882
IF ZNo THEN _
GOTO 12880
* REPLACING old line(s) by new
20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
' $PAGE
'
' NAME -- CheckRatio
'
' INPUTS -- PARAMETER MEANING
' TellUser TELL USER THEIR RATIO
' ZDnlds FILES DOWNLOADED
' ZDLBytes! BYTES DOWNLOADED
' ZUplds FILES UPLOADED
' ZULBytes! BYTES UPLOADED
'
' OUTPUTS -- ZOK -1 if okay to download, 0 otherwise
'
' PURPOSE -- To determine whether the users violated
' their upload to download restriction
'
SUB CheckRatio (TellUser) STATIC
ZOK = ZTrue
* ------[ first line different ]------
IF ZFreeDnld THEN _
GOTO 20110
'
' Detemine method of ratio checking. Look ahead to amount downloaded
'
IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
Method$ = "Bytes" : _
ULWork# = ZULBytes! : _
DLWork# = ZDLBytes! + ZNumDnldBytes!
IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
Method$ = "Files" : _
ULWork# = ZUplds : _
DLWork# = ZDnlds + ZDownFiles
IF ULWork# < ZInitialCredit# THEN _
ULWork# = ZInitialCredit#
IF ZByteMethod = 2 THEN _
Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
IF ZByteMethod = 3 THEN _
Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
'
Ratio# = 0
RatioSuffix$ = ":0"
IF ULWork# > 0 THEN _
Ratio# = (DLWork# / ULWork#) : _
RatioSuffix$ = ":1"
IF ZByteMethod > 1 THEN _
ZOutTxt$ = "Today's Downloaded Files: " + STR$(ZDLToday! + ZDownFiles)+ZCrLf$ + _
"Number of Bytes Today : " + STR$(ZBytesToday! + ZNumDnldBytes!) : _
ZSubParm = 5 : _
CALL TPut : _
CALL SkipLine (1) : _
GOTO 20100
WasX$ = STR$(Ratio#)
X = INSTR(WasX$,".")
IF X > 0 THEN _
WasX$ = LEFT$(WasX$,X+1)
ZOutTxt$ = ZFG1$ + Method$ + " Downloaded: " + ZFG2$ +STR$(DLWork#)+ZCrLf$+ _
ZFG3$ + Method$ + " Uploaded : " + ZFG2$ +STR$(ULWork#) + ZCrLf$
ZOutTxt$ = ZoutTxt$ + ZFG4$ + "Todays Downloaded Files: " + ZFG1$ + _
STR$(ZDLToday! + ZDownFiles) + ZCrLf$ +"Ratio : " +ZFG3$ + _
WasX$ + RatioSuffix$ +ZEmphasizeOff$
ZSubParm = 5
CALL TPut 'Pe 02/16/90
'
' CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
'
* REPLACING old line(s) by new
* ------[ first line different ]------
20100 IF NOT ZEnforceRatios OR ZRatioRestrict# <= 0 THEN _
GOTO 20110 'Pe 02/16/90
IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
EXIT SUB
IF ZByteMethod <= 1 THEN _
GOTO 20105
IF Today# < 0 THEN _
ZOutTxt$ = "Sorry, Daily download limit of" + _
STR$(ZRatioRestrict#) + " " + _
Method$ + " Reached" : _
ZOK = ZFalse : _
CALL DelayTime (3) _ 'Pe 02/03/90
ELSE ZOutTxt$ = "Download balance:" + _
STR$(Today#) + _
" " + _
Method$ : _
ZOK = ZTrue
ZSubParm = 5
CALL TPut
CALL SkipLine(1)
EXIT SUB
'
* REPLACING old line(s) by new
20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
ZOK = ZFalse : _
* ------[ first line different ]------
ZOutTxt$ = "Sorry, DL/UL ratio of" + _
STR$(ZRatioRestrict#) + _
":1 " + _
Method$ + " exceeded" + CHR$(7) : _
ZSubParm = 5 : _
CALL TPut : _
Call DelayTime (4) : _ 'Pe 06/13/91
ZOutTxt$ = "Minimum upload of" + _
STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
/ ZRatioRestrict#) + 1)) + _
+ " " + Method$ + " required to download" _
ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
" " + Method$
ZSubParm = 5
CALL TPut
CALL SkipLine (1)
* REPLACING old line(s) by new
20141 IF ZAnsIndex >= ZLastIndex THEN _
IF LEN(ZDefaultExtension$) > 0 THEN _
* ------[ first line different ]------
Call GetRBBSString(87,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$ + " "+ZDefaultExtension$)
WasZ$ = "V"
CALL AskItems ("V",WasZ$,ZFalse,"file",ZMarkedFiles$)
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
EXIT SUB
ZViolation$ = "View ARC"
WasX = ZAnsIndex
ZAnsIndex = WasX
* REPLACING old line(s) by new
20142 IF ZAnsIndex > ZLastIndex THEN _
* ------[ first line different ]------
IF ZLastIndex > 1 OR Drive$ <> "" THEN _ ' KG091001
EXIT SUB _
ELSE GOTO 20141
GOSUB 20143
IF ZSubParm < 0 THEN _
EXIT SUB
ZAnsIndex = ZAnsIndex + 1
GOTO 20142
* REPLACING old line(s) by new
20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
CALL UnMarkItems (ZMarkedFiles$,ZAnsIndex, ZLastIndex,Temp,ZFalse)
ZWasZ$ = ZUserIn$(ZAnsIndex)
WasZ$ = ZWasZ$
CALL AllCaps (ZWasZ$)
CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
IF Ext$ = "" THEN _
Ext$ = ZDefaultExtension$ : _
ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
* ------[ first line different ]------
ZLastExt$ = Ext$ 'Pe 08/12/91
ZFileNameHold$ = ZWasZ$
ZFileName$ = ZWasZ$
WasI = 1 'Pe 04/21/92
CALL BadFile (Prefix$,BadFileNameIndex)
ON BadFileNameIndex GOTO 20144,20146,20147
* REPLACING old line(s) by new
* ------[ first line different ]------
20145 IF Drive$ <> "" THEN _ ' KG091001
ZFileNameHold$ = Prefix$ + "." + Ext$ : _ ' KG091001
CALL FindFile (ZFileName$,ZOK) _ ' KG091001
Else CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V")
IF ZOK THEN _
GOTO 20148
If ZPersonalDnld Then _ 'Pe 08/12/91
ZFileName$ = ZPersonalDrvPath$ + ZWasZ$ : _ 'Pe 08/12/91
CALL FindFile (ZFileName$,ZOK) 'Pe 08/12/91
IF ZOK THEN _ 'Pe 08/12/91
GOTO 20148 'Pe 08/12/91
ZWasZ$ = ZFileName$ 'Pe 04/21/92
CALL BreakFileName (ZFileName$,DR$,Prefix$,Ext$,ZFalse) 'Pe 04/21/92
WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".") 'Pe 04/21/92
IF WasJ = 0 THEN _ 'Pe 04/21/92
GOTO 20146 'Pe 04/21/92
Check$ = MID$(ZCompressedExt$,WasI,WasJ-1) 'Pe 04/21/92
WasI = WasI + WasJ 'Pe 04/21/92
ZFileName$ = Prefix$ + "." + Check$ 'Pe 04/21/92
ZLastExt$ = Check$ 'Pe 04/21/92
ZFileNameHold$ = ZFileName$ 'Pe 04/21/92
GOTO 20145 'Pe 04/21/92
* REPLACING old line(s) by new
* ------[ first line different ]------
20148 WasX$ = ZDiskForDos$ + "VU_FILE.BAT" 'Pe 12/29/92
' WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT" 'Pe 09/25/91
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 20170 'Pe 11/02/91
'
' adds FileSec to ViewArc commands
'
CALL OpenWork (2,ZFileSecFile$)
IF ZErrCode = 53 THEN _
CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
ZErrCode = 0 : _
GOTO 20165
* DELETING old line(s)
20150
* INSERTING new line(s)
20160 IF EOF(2) THEN _
GOTO 20165
CALL ReadParms (ZWorkAra$(),3,1)
IF ZErrCode <> 0 THEN _
CALL UpdtCalr (ZFileSecFile$ + " error in file!",2) : _
GOTO 20165
CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
IF NOT ZOK THEN _
GOTO 20160
IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
GOTO 20162
FilePswd$ = ZWorkAra$(3)
IF FilePswd$ = "" THEN _
GOTO 20165
CALL AraAllCaps (ZUserIn$(),1)
IF ZUserIn$(1) = FilePswd$ THEN _
GOTO 20165
Call GetRBBSString(293,RBBSString$) 'Pe 01/16/93
ZOutTxt$ = RBBSString$ + ZFileNameHold$ 'Pe 01/16/93
ZSubParm = 1
Call TGet
IF ZSubParm < 0 THEN _
Exit Sub
IF ZWasQ = 0 THEN _
RETURN
CALL AllCaps (ZUserIn$(1))
IF ZUserIn$(1) = FilePswd$ THEN _
GOTO 20165
20162 ZViolation$ = "View " + _
ZFileName$
Call GetRBBSString(88,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
Call QuickTPut1 (OutTxt$)
20163 CALL SecViolation
IF ZDenyAccess THEN _
ZFileSysParm = 4
RETURN
'
' End of changes
'
20165 Call GetRBBSString(89,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut1 (ZFileNameHold$ + OutTxt$) 'Pe 09/25/91
ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
CALL OpenWork (2,WasX$) 'Pe 11/02/91
CALL ReadDir (2,1)
IF EOF(2) THEN _
ZWasZ$ = ZOutTxt$ : _
ZGSRAra$(1) = ZFileName$ : _
ZGSRAra$(2) = ZArcWork$ _
ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
" " + ZArcWork$ + " " + ZGSRAra$(3) + " " + Ext$ + " " + ZNodeId$
CALL ShellExit (ZWasZ$)
CALL Findit (ZDiskForDOS$ + "NOVIEW."+ ZNodeId$) 'Pe 12/29/92
IF ZOK Then _ 'Pe 12/29/92
Call KillWork(ZDiskForDOS$ + "NOVIEW."+ ZNodeId$) : _
GOTO 20170 'Pe 12/29/92
CALL BufFile (ZArcWork$,WasX)
CALL ViewTxt 'located in Rbbssub1.bas
RETURN
20170 Call GetRBBSString(90,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93
CALL QuickTPut1 (OutTxt$ + " "+Ext$+" files") 'Pe 11/02/91
RETURN
END SUB
* REPLACING old line(s) by new
20245 SUB SetBPS (BaudTest!,BPS) STATIC
* ------[ first line different ]------
IF BaudTest! = 2400 THEN _
BPS = -4 _
ELSE IF BaudTest! = 1200 OR BaudTest! = 1275 THEN _
BPS = -3 _
ELSE IF BaudTest! >= 7200 AND BaudTest! < 19200 THEN _
GOTO 20246 _
ELSE IF BaudTest! = 0 OR BaudTest! = 300 THEN _
BaudTest! = 300 : _
BPS = -1 _
ELSE IF BaudTest! = 19200 THEN _
BPS = -11 _
ELSE IF BaudTest! = 38400 THEN _
BPS = -12 _
ELSE IF BaudTest! = 4800 THEN _
BPS = -5 _
ELSE BPS = 0
EXIT SUB
* REPLACING old line(s) by new
20246 IF BaudTest! = 14400 THEN _
BPS = -9 _
ELSE IF BaudTest! = 16800 THEN _
BPS = -10 _
ELSE IF BaudTest! = 7200 THEN _
BPS = -6 _
ELSE IF BaudTest! = 12000 THEN _
BPS = -8 _
ELSE BPS = -7 ' 9600
END SUB
* ------[ first line different ]------
'
* INSERTING new line(s)
20340 ' $SUBTITLE: 'QuickPeek - Easy find user to send message to' ' DD062502
' $PAGE ' DD062502 ' DD062502
' NAME -- QuickPeek - A Dan & Howard Mod - Dan Drinnon 1992 ' DD062502
' ' DD062502
' INPUTS -- PARAMETER MEANING ' DD062502
' ' DD062502
' OUTPUTS -- ZUserIn$ Search String User Input ' DD062502
' MsgTo$ Who Message is To ' DD062502
' PURPOSE -- Save User keystrokes when looking for message addressee' DD062502
' ' DD062502
SUB QuickPeek (ZUserIn$,MsgTo$,Found) Static ' DD070801
IF Found = ZTrue THEN EXIT SUB ' DD070801
Found = ZFalse
ZLastDateTimeOnSave$ = ZLastDateTimeOn$ ' DD062502
HoldRecordPosition$ = ZUserRecord$ ' DD081401
UserInName$ = ZUserIn$ ' DD062502
WhichUser = 1
Call GetRBBSString(91,RBBSString$) 'Pe 01/16/93
OutTxt$ = RBBSString$ 'Pe 01/16/93 ' DD062502
CALL QuickTPut (OutTxt$ + " " + MsgTo$,0) ' DD081501
NumDots = 0 ' DD081401
CALL OpenUser (ZHighestUserRecord) ' DD062502
WHILE NOT EOF(5) ' DD062502
GET #5, WhichUser ' DD062502
TempMsgTo$ = ZUserName$ ' DD062502
CALL TRIM (TempMsgTo$) ' DD062502
IF UserInName$ = TempMsgTo$ THEN EXIT SUB ' DD062502
IF INSTR(TempMsgTo$,UserInName$) > 0 THEN ' DD062502
IF TempMsgTo$ = ZSecretName$ THEN _ ' DD080301
GOTO 20350 ' DD080301
ZSubParm = 1 ' DD062502
ZOutTxt$ = ZCRLf$ + "Send to: " + TempMsgTo$ + _ ' DD081401
" (Y)es,[N])o,A)bort)" ' DD081401
ZTurboKey = -ZTurboKeyUser ' DD062502
CALL PopCmdStack ' DD062502
IF ZSubParm = -1 THEN _ ' DD062502
LSET ZUserRecord$ = HoldRecordPosition$ : _ ' DD081401
EXIT SUB ' DD062502
ZWasZ$ = ZUserIn$(1) ' DD062502
CALL AllCaps (ZWasZ$) ' DD062502
IF ZWasZ$ = "A" THEN _ ' DD062502
MsgTo$ = "" : _ ' DD062502
Found = ZTrue : _ ' DD070801
LSET ZUserRecord$ = HoldRecordPosition$ : _ ' DD081401
EXIT SUB ' DD062502
IF ZWasZ$ = "Y" THEN ' DD062502
MsgTo$ = TempMsgTo$ ' DD062502
ZUserIn$ = TempMsgTo$ ' DD062502
Found = ZTrue ' DD070801
LSET ZUserRecord$ = HoldRecordPosition$ ' DD081401
ZLastDateTimeOn$ = ZLastDateTimeOnSave$ ' DD062502
EXIT SUB ' DD062502
ELSE ' DD062502
WhichUser=WhichUser+1 : _ ' DD081401
NumDots = 0 : _ ' DD081401
Call GetRBBSString(91,RBBSString$) : _ 'Pe 01/16/93
OutTxt$ = RBBSString$ : _ 'Pe 01/16/93
CALL QuickTPut (OutTxt$ + " " + ZUserIn$,0) ' DD081401
END IF ' DD062502
ELSE ' DD062502
20350 WhichUser=WhichUser+1 ' DD080301
END IF ' DD062502
CALL MarkTimeB (NumDots) ' DD012602
WEND ' DD062502
CALL SkipLine (1) ' DD081401
Found = ZFalse ' DD070801
LSET ZUserRecord$ = HoldRecordPosition$ ' DD081401
ZLastDateTimeOn$ = ZLastDateTimeOnSave$ ' DD062502
END SUB ' DD062502